The Best of MacTutor - S…e Code for Volumes 1 to 5/The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin/Source Code/#26 (Nov 87)/Pascal Code Tester/CodeTesterStuff

Text File | 1987-10-26 | 7KB | 303 lines

PROGRAM CodeTester;

(* Version 1.1 *)
(* © CopyRight 1987 by J.E.Fox, for Mactutor™ *)

{I-}

    USES
        ROM85, TestGlobals, TestStuff;

    PROCEDURE crash;
    BEGIN
        ExitToShell;
    END;

    PROCEDURE DoAbout;
        VAR
            MyAbout : DialogPtr;
            ItemHit : Integer;
    BEGIN
        MyAbout := GetNewDialog(AboutId, NIL, Pointer(-1));
        ShowWindow(MyAbout);
        ModalDialog(NIL, ItemHit);
        CASE ItemHit OF
            1 :
                DisposDialog(MyAbout);
            OTHERWISE
                BEGIN
                END;
        END;  (* Case of *)
    END;  (* DoAbout *)

    PROCEDURE ProcessMenu_in (CodeWord : longint);
        VAR
            Menu_No : integer;        {menu number that was selected}
            Item_No : integer;        {item in menu that was selected}
            Name : Str255;               {name holder for desk accessory or font}
            OpenDAResult : integer;
            TempPort : Grafptr;    {protect against DA}
    BEGIN
        IF CodeWord <> 0 THEN
            BEGIN {go ahead and process the command}
                Menu_No := HiWord(CodeWord);   {get the Hi word of...}
                Item_no := LoWord(CodeWord);   {get the Lo word of...}
                CASE Menu_No OF
                    AppleMenu :
                        BEGIN
                            CASE Item_No OF
                                1 :
                                    DoAbout;
                                OTHERWISE
                                    BEGIN
                                        GetItem(AppleMHandle, Item_No, Name);
                                        GetPort(TempPort);
                                        OpenDAResult := OpenDeskAcc(Name);
                                        SetPort(TempPort);
                                    END;     (* Otherwise *)
                            END         (* Case Item_No of *)
                        END;          (* Case Menu_No of *)
                    FileMenu :
                        BEGIN
                            CASE Item_No OF
                                1 :
                                    theTest;
                                2 :
                                    BEGIN
                    (* The dividing Line *)
                                    END;
                                3 :
                                    BEGIN
                                        SetCursor(Watch);
                                        Finished := True;          (* quit *)
                                    END;
                            END;    (* Item_No of (File) *)
                        END;    (* Menu_No of (File) *)
                END; (* Case Menu_No of *)
                HiliteMenu(0);               (* unhilite after processing menu *)
            END; (* the If codeword <>0 *)
    END; (* of ProcessMenu_in procedure *)

    PROCEDURE DealwthMouseDowns (Event : EventRecord);
        VAR
            WindowPointedTo : WindowPtr;
            GlobalMouse, LocalMouse : Point;
            WindoLoc : integer;
            TempPort : GrafPtr;
    BEGIN
        GlobalMouse := Event.Where;
        LocalMouse := GlobalMouse;
        GlobalToLocal(LocalMouse);
        WindoLoc := FindWindow(GlobalMouse, WindowPointedTo);
        CASE WindoLoc OF
            inMenuBar :
                ProcessMenu_in(MenuSelect(GlobalMouse));
            inSysWindow :
                SystemClick(Event, WindowPointedTo);
            inContent :
                BEGIN
                    IF WindowPointedTo <> FrontWindow THEN
                        BEGIN
                            SelectWindow(WindowPointedTo);
                            SetPort(WindowPointedTo);
                        END;
                END;    {InContent}
            inGrow :
                BEGIN
                END;
            inDrag :
                BEGIN
                    DragWindow(WindowPointedTo, GlobalMouse, DragArea);
                END;
            inGoAway :
                BEGIN
                    IF TrackGoAway(WindowPointedTo, GlobalMouse) THEN
                        HideWindow(WindowPointedTo);
                END;
            InZoomIn, InZoomOut :
                BEGIN
                    IF TrackBox(WindowPointedTo, GlobalMouse, WindoLoc) THEN
                        BEGIN
                            GetPort(TempPort);
                            SetPort(WindowPointedTo);
                            EraseRect(WindowPointedTo^.portRect);
                            ZoomWindow(WindowPointedTo, WindoLoc, True);
                            SetPort(TempPort);
                        END;
                END;
            OTHERWISE
                BEGIN
                END;
        END;       (* CASE WindoLoc of *)
    END;    (* DealwthMouseDowns *)

    PROCEDURE DealwthKeyDowns (Event : EventRecord);
        VAR
            CharCode : char;
    BEGIN
        CharCode := Chr(Event.message MOD 256);
        IF BitAnd(Event.modifiers, CmdKey) = CmdKey THEN
            ProcessMenu_in(MenuKey(CharCode));
    END;

    PROCEDURE Activate_DeActivate (Event : EventRecord);
        VAR
            TargetWindow : WindowPtr;
    BEGIN
        TargetWindow := WindowPtr(Event.message);
        IF Odd(Event.modifiers) THEN
            BEGIN    (* then the window is becoming active *)
                SetPort(TargetWindow);
                TEActivate(JeffsText);
            END  (* If Odd *)
        ELSE
            BEGIN
                TEDeactivate(JeffsText);
            END;  (* Deactivate *)
    END;  (* Activate_DeActivate *)

    PROCEDURE DealwthUpdates (Event : EventRecord);
        VAR
            UpDateWindow, TempPort : WindowPtr;
    BEGIN
        UpDateWindow := WindowPtr(Event.message);
        GetPort(TempPort);
        SetPort(UpDateWindow);
        BeginUpDate(UpDateWindow);
        EraseRect(UpDateWindow^.portRect);
        MoveHHi(handle(JeffsText));
        HLock(handle(JeffsText));
        TEUpdate(UpdateWindow^.portRect, JeffsText);
        theDrawing;
        HUnlock(handle(JeffsText));
        EndUpDate(UpDateWindow);
        SetPort(TempPort);
    END;

    PROCEDURE MainEventLoop;
        VAR
            Event : EventRecord;
    BEGIN
        REPEAT
            SystemTask;
            TEIdle(JeffsText);
            IF GetNextEvent(EveryEvent, Event) THEN
                CASE Event.what OF
                    mouseDown :
                        DealwthMouseDowns(Event);
                    KeyDown, AutoKey :
                        DealwthKeyDowns(Event);
                    ActivateEvt :
                        Activate_DeActivate(Event);
                    UpDateEvt :
                        DealwthUpdates(Event);
                    OTHERWISE
                        BEGIN
                        END;
                END;(* of Case *)
        UNTIL Finished;
    END;

    PROCEDURE PrimeMemory;
    BEGIN
{    MaxApplZone;  Grow Heap to Limit }
        MoreMasters;                      (* Allot 5, 64 Mptr Blocks *)
        MoreMasters;
        MoreMasters;
        MoreMasters;
        MoreMasters;
    END;

    PROCEDURE Close;
    BEGIN
    END;

(* ŸŸŸ      Following are called by Set Up       ŸŸŸŸŸ *)

    PROCEDURE Energize;
        VAR
            BeamH, WatchH : CursHandle;
    BEGIN
        InitGraf(@thePort);     (* Set up all Managers *)
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(@crash);    (* crash is Proc to 'Resume' in Bomb DLOG *)
        InitAllPacks;
        FlushEvents(everyEvent, 0);

        WatchH := GetCursor(watchCursor);    (* Put watchs Mptr address on stack *)
        HLock(Handle(WatchH));        (* Just in case, Note the type clash *)
        Watch := WatchH^^;            (* DDeref and store, easier to call *)
        SetCursor(Watch);            (* Wrap 10 Mr. Sulu *)
        Finished := False;                    (* program terminator *)
    END;

    PROCEDURE SetupMenus;

    BEGIN
        AppleMHandle := GetMenu(AppleMenu);
        InsertMenu(AppleMHandle, 0);
        FileMHandle := GetMenu(FileMenu);
        InsertMenu(FileMHandle, 0);
        AddResMenu(AppleMHandle, 'DRVR');
        MoveHHI(Handle(AppleMHandle));
        HLock(Handle(AppleMHandle));        (* since this could be dumped *)
        MoveHHI(handle(FileMHandle));
        HLock(Handle(FileMHandle));

        DrawMenuBar;
    END;

    PROCEDURE SetupLimits;
    BEGIN
        Screen := ScreenBits.Bounds;   {set the size of the screen}
        SetRect(DragArea, Screen.left + 4, Screen.top + 24, Screen.right - 4, Screen.bottom - 4);
        SetRect(GrowArea, Screen.left, Screen.top + 24, Screen.right, Screen.bottom);
        SetRect(WindowArea, Screen.left + 10, Screen.Top + 40, Screen.right - 200, Screen.bottom - 200);
    END;

    PROCEDURE SetUpWindow;
        VAR
            title : str255;
    BEGIN
        title := 'Code Tester';
        JeffsWindow := NewWindow(NIL, WindowArea, title, FALSE, 8, pointer(-1), TRUE, 1);
        IF JeffsWindow = NIL THEN
            crash;
        SetPort(JeffsWindow);
        TextFont(applFont);
        TextSize(12);
        TextFace([]);
        TextMode(1);
    END;

    PROCEDURE SetUpTE;
    BEGIN
        WITH JeffsWindow^.portRect DO
            BEGIN
                SetRect(ViewArea, left + 4, top + 4, right - 1, bottom - 1);
            END;
        DestArea := ViewArea;
        JeffsText := TENew(DestArea, ViewArea); { must be done after setPort}
    END;

    PROCEDURE MainSetUp;
    BEGIN
        Energize;
        SetupMenus;
        SetupLimits;
        SetUpWindow;        (* Save Room for the windows if used *)
        SetUpTE;
        InitCursor;          (* ready to go, so show the Arrow cursor *)
    END;

(* ŸŸŸŸŸŸŸ Main Program ŸŸŸŸŸŸŸ *)

BEGIN
{PrimeMemory;}
    MainSetUp;
    MainEventLoop;
    Close;
END.